COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "finger  -- L. Earnest,  14 July 1973"
C00007 00003	say("JOB JOBNAM  PN:   WHO             LR  LINE  ROOM   LOCATION"&↓)
C00010 ENDMK
C⊗;
begin "finger  -- L. Earnest,  14 July 1973"
require "head[1,les]" source_file;

define safer=[];	! safer is applied to arrays;

This program identifies current users and the locations of their terminals;

integer i,jobmax,jbtsts,jbtlin,prjprg,ptyjob,ftime,pno;
integer j,users,cdate,ctime,seg;
string s,t;

safer string array name,loc[1:64];
safer integer array job,pn,tty[1:64];

scnbrk(totab,"	","","ins");

define namax=[16];	! max. # of words to hold NET,GUE name;
procedure realname;	begin	! gets NET,GUE names from TMPCOR;
	safer own integer array addr[0:2];
	integer own array buf[1:namax];
	integer who,gue,adrloc,ri;
	external integer _skip_;
	
	! initialize who,gue,addr[], and adrloc for NET,GUE;
	who←cvsix("WHO");  gue←cvsix("   GUE");
	start_code
		protect_acs 2;
		move 2,buf;
		subi 2,1;
		hrli 2,-namax;		! 1=[iowd namax,,buf[1]];
		movem 2,access(addr[1]);
		move 2,addr;
		hrli 2,1;
		movem 2,adrloc;
		end;

	for ri → users do if pn[ri]=gue then begin
		addr[0]←who+job[ri];
		call(adrloc,"tmpcrd");
		if _skip_ then begin "got it"
			string rs;  integer rj;
			rs←"*";
			for rj → namax do begin
				rs←rs&cvstr(buf[rj]);
				if buf[rj] land '376 = 0 then done;
				end;
			for rj←ln(rs) step -1 until 1 do
			    if rs[rj for 1]≠0 then done;
			name[ri]←rs[1 to rj];
			end;
		end;
	end "REALNAME";
	
backup;  s←inchwl;
if s="F" ∨ s="f" then begin setbreak(18," ",null,"INS"); say(↓) end
    else setbreak(18,";",null,"INS");
pno←scan(s,18,brk);  pno←cvsix(right(6,s));  ! sixbit pn or 0;

i←call(call('215,"peek"),"peek")%3600;	! uptime in minutes;
outstr("UPTIME= "&(if (j←i%1440) then cvs(j)&" d " else null)
 &cvs((i%60) mod 24)&" hr ");

setformat(-2,0);	outstr(cvs(i mod 60)&" min"&↓);

jobmax←call('222,"peek");	! maximum number of jobs;
jbtsts←call('210,"peek");	! location of job status table;
prjprg←call('211,"peek");	! location of project-programmer table;
jbtlin←call('236,"peek");	! location of line number table;
ptyjob←call('270,"peek");	! location of pty superior job table;
ftime←call('274,"peek");	! location of date,,seconds since run;

users←0;	seg←cvsix("*SEG* ");
for i → jobmax do if call(jbtsts+i,"peek") land (1 lsh 30)
    ∧ (J←call(prjprg+i,"peek"))≠seg
    ∧ ((j←j land '777777)=pno ∨ ¬pno) then begin
	job[users←users+1]←i;	pn[users]←j;
	tty[users]←call(jbtlin+i,"peek");
	name[users]←loc[users]←null;
	end;

s←look("fact.txt[spl,sys]");  this file gives pn<tab>full name;
if users=0 then begin "none found"
	string nam;
	nam←cvxstr(pno);  say(nam[4 to 6]&" is not logged in");
	while ln(s) do if cvsix(right(6,totab(s)))≠pno then s←inline else begin
		say("(i.e. "&s&")"&↓); done
		end;
	if ln(s)=0 then say(" and is not an authorized user"&↓);
	release(inch);	call(0,"exit");
	end;

say("JOB JOBNAM  PN:   WHO             LR  LINE  ROOM   LOCATION"&↓);
do begin
	i←cvsix(right(6,totab(s)));  ! sixbit pn right justified;
	for j → users do if i=pn[j] then name[j]←s;
	end
    until ln(s←inline)=0;
release(inch);
realname;

s←look("places[m,les]");  This file gives rooms for tty lines;
for i←0 thru '117 do begin
	for j → users do if i=tty[j] land '377 then begin loc[j]←s; done end;
	s←inline;
	end;
release(inch);

cdate←call(0,"date") lsh 18;		! current date in left half;
ctime←call(0,"timer")%60;		! seconds since midnight;
setformat(2,0);
for i → users do begin "printout"
	integer lr,tim;

	j←job[i];	s←cvxstr(pn[i]);
	say(cvs(j)&". "&cvxstr(call(j,"getnam"))&" "&s[4 to 6]&": ");
	say(left(17,if ln(s←name[i]) then s  else "UNKNOWN"));

	tim←call(ftime+j,"peek");	! time since last run;
	lr←((if cdate=(tim land ('777777 lsh 18)) then 0 else 86400) +
	    ctime -(tim land '777777))div 60;
	say(if lr then right(3,cvs(lr))&" " else "    ");

	if (j←tty[i])=-1 then outstr("detached"&↓) else
	    if j land ('4000 lsh 18) then begin "PTY"
		integer sup;
		sup←call(ptyjob+(j land '377)-'121,"peek"); ! superior job #;
		s←cvxstr(call(sup,"getnam"));		! superior job name;
		outstr(left(13,"PTY"&cvos(j land '377))&"job "&cvs(sup)&". "&
		    (if j land ('1000 lsh 18) then "Arpanet site "&s[3 to ∞]
		    else s)&↓);
		end "PTY"
	    else outstr(loc[i]&↓);
	end "printout";
call(0,"exit");
end